Internet Info 1993

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1993 / Internet Info CD-ROM (Walnut Creek) (1993).iso / networking / terms / kermit / b / k11st0.mac < prev next >

Wrap

Text File | 1989-06-12 | 26.6 KB | 1,185 lines

.title k11st0 the SET command,overlay zero .ident /2.0.05/ .if ndf, K11INC .ift .include /IN:K11MAC.MAC/ .include /IN:K11CDF.MAC/ .endc .enabl gbl .enabl lc .psect $code $cmglob = 0 ; Copyright (C) 1984 Change Software, Inc. ; ; 31-Jan-84 15:13:45 Brian Nelson ; ; Removed SET command code from K11CMD.MAC for space saving via ; placement into an overlay. .psect $code .sbttl set a line for dilaing out and speed .enabl lsb set$li::mov sp ,doallo ; /58/ Assume exclusive owner mov #ttname ,r1 ; /58/ Destination mov argbuf ,r0 ; /58/ Source 10$: cmpb (r0) ,#'/ ; /58/ Included /[NO]ALLOCATE beq 20$ ; /58/ Yes, exit movb (r0)+ ,(r1)+ ; /58/ No, just copy bne 10$ ; /58/ Next please br 40$ ; /58/ Skip qualifier processing 20$: clrb (r1) ; /58/ Insure .asciz inc r0 ; /58/ Skip past the '/' cmpb (r0) ,#'N&137 ; /58/ Was it /N bne 30$ ; /58/ No clr doallo ; /58/ Yes, say so then br 40$ ; /58/ Continue on 30$: cmpb (r0) ,#'A&137 ; /58/ Try /A bne 110$ ; /58/ Error 40$: STRCPY #ttdial ,#ttname ; /58/ Copy device name here also tst doallo ; /58/ Should we take the device? beq 50$ ; /58/ No calls assdev ,<#ttname> ; try to get the exec to allocate it tst r0 ; did the allocation work ? beq 60$ ; no message <Error from device assignment > direrr r0 ; print out the directive error return ; and exit 50$: calls noecho ,<#ttname> ; try to disable echoing 60$: clr remote ; no longer are we remote calls ttpars ,<#ttname> ; see if the terminal is KB: or TI: cmpb r0 ,#377 ; well ? bne 100$ ; no mov sp ,remote ; yes, we are now the remote system calls gttname ,<#ttname> ; get our local terminal number copyz #ttname ,#ttdial ; and update it please message <Kermit-11 no longer running in LOCAL mode>,cr 100$: call linsts clr r0 110$: return .dsabl lsb .enabl lsb linsts: tst infomsg ; /41/ Print this info today? beq 100$ ; /41/ No message <Link device: > ; /40/ format info about link status print #ttname ; /40/ name calls ttspeed ,<#ttname> ; /40/ current speed tst r0 ; /40/ Is speed settable? bne 10$ ; /40/ yes message < Speed not settable> ; /40/ no br 20$ ; /40/ next please 10$: message < Speed: > ; /40/ dump it decout r0 ; /40/ 20$: calls inqdtr ,<#ttname> ; /40/ see if dtr or cd is up tst r0 ; /40/ if < 0 , then not supported bmi 40$ ; /40/ no good bgt 30$ ; /40/ Dtr's up message < DTR/CD not currently present> ; /40/ a message br 40$ ; /40/ next 30$: message < DTR/CD present> ; /40/ it's there 40$: message ; /40/ all done calls inqpar ,<#ttname> ; /53/ Check for parity tst r0 ; /53/ Set? beq 100$ ; /53/ NO movb #PAR$SPACE,parity ; /53/ Force 7bit mode message <Parity is set, forcing 7bit mode>,CR 100$: return ; /40/ exit global <infomsg,ttname> global <INQPAR,INQDTR,DOALLO> .dsabl lsb .sbttl more terminal setting options .enabl lsb set$sp::calls l$val ,<argbuf> ; get the speed into decimal tst r0 ; ok ? bne 30$ ; yes call ttchk ; is a line assigned now ? bcs 100$ ; no calls setspd ,<#ttname,r1,#lun.co>; set the speed please tst r0 ; did it work ? beq 100$ ; yes, exit cmp r0 ,#377 ; bad speed ? beq 30$ direrr r0 br 100$ 30$: message <Bad value for speed or speed not settable>,cr 100$: clr r0 return global <argbuf ,lun.co> .dsabl lsb ttchk: tstb ttname ; insure a line is set beq 10$ ; ok clc return 10$: message <Please use the SET LINE command>,cr sec return global <argbuf ,modem ,remote ,ttdial ,ttname> .sbttl set debug whatever set$de::calls getcm0 ,<argbuf,#dbglst>; find out which option was given tst r0 ; did we find one bmi 110$ ; no calls getcm1 ,<argbuf,#dbglst,r0> tst r0 ; now get arguement if needed bmi 110$ ; oops jsr pc ,@r1 ; dispatch now return ; bye 110$: call sd$hel ; error, print a help and exit clr r0 ; say we have no errors return ; bye .enabl lsb ; for message macro in SDOPEN sdopen: bit #log$op ,trace ; a logfile open ? bne 200$ ; yes message <Please use the SET LOGFILE command first>,cr clr r0 ; and exit with carry set sec ; error exit return ; bye 200$: clc ; return with file status open return ; bye .dsabl lsb $cmglob = 0 ; don't make these routines global command dbglst ,ALL ,3 ,sd$all command dbglst ,CONSOLE,3 ,sd$con command dbglst ,CONNECT,3 ,sd$con command dbglst ,FILE ,3 ,sd$fil command dbglst ,HELP ,3 ,sd$hel command dbglst ,NONE ,3 ,sd$none command dbglst ,OFF ,3 ,sd$off command dbglst ,ON ,2 ,sd$on command dbglst ,PACKET ,3 ,sd$pak command dbglst ,RAW ,3 ,sd$raw command dbglst ,RPACK ,3 ,sd$rpa command dbglst ,STATE ,3 ,sd$sta command dbglst ,TERMINAL,3 ,sd$ter command dbglst ,NOTERMINAL,3 ,sd$not command dbglst .sbttl routines for SET DEBUG .enabl lsb sd$none: sd$off::bic #log$al ,trace ; clear all debug bits now bit #log$op ,trace ; is there a log file open ? beq 20$ ; no calls close ,<#lun.lo> ; close it bic #log$op ,trace ; say it's closed please tst infomsg ; /41/ Inform the user? beq 20$ ; /41/ No message <Log_file closed>,cr ; /41/ Call it Log file now 20$: clr r0 return sd$all: sd$on: bic #log$al ,trace ; insure previous logfile closed call rawchk ; disallow other logging if raw logging bcs 100$ ; oops call sdopen ; a debug file already open ? bcs 100$ ; no bis #log$al ,trace ; set debug on turns the world on clr r0 100$: return sd$ter: mov sp ,debug ; i/o to local kermit terminal clr r0 return sd$not: clr debug clr r0 return global <argbuf ,debug ,lun.lo ,trace ,errtxt ,logfil> .dsabl lsb .sbttl more set debug routines ; SD$CON enable logging of virtual connect i/o to disk file ; ; SD$PAK enable logging of all packets to disk file ; ; SD$STA enable logging of all states to disk file sd$con: call sdopen ; logfile open ? bcs 100$ ; no bis #log$co ,trace ; yes, set console emulation logging clr r0 100$: return sd$fil: call sdopen ; logfile open ? bcs 100$ ; no call rawchk ; disallow other logging if raw logging bcs 100$ ; oops bis #log$fi ,trace ; yes, set file opens and creates clr r0 100$: return sd$pak: call sdopen ; logfile open bcs 100$ ; no call rawchk ; disallow other logging if raw logging bcs 100$ ; oops bis #log$pa ,trace ; yes, set packet logging on clr r0 100$: return sd$sta: call sdopen ; logfile open bcs 100$ ; no call rawchk ; disallow other logging if raw logging bcs 100$ ; oops bis #log$st ,trace ; yes, set state logging on clr r0 100$: return .sbttl check for oding raw terminal i/o dumps .enabl lsb sd$raw: call sdopen ; logfile open bcs 100$ ; no mov trace ,r0 bic #log$op ,r0 tst r0 beq 10$ message <Can't do RAW i/o disk logging with other DEBUG options set> message br 100$ 10$: bis #log$io ,trace ; yes, set state logging on calls close ,<#lun.lo> calls create ,<#logfil,#lun.lo,#binary> ; redo as image file message <Old logfile closed and new logfile created in BINARY mode>,cr 100$: clr r0 return rawchk: bit #log$io ,trace beq 200$ message <Can't do disk logging with RAW i/o logging on>,cr sec return 200$: clc return sd$rpa: bis #log$rp ,trace clr r0 return sd$hel: message message <To enable:>,cr message < Connection logging SET DEBUG CONSOLE>,cr message < File opens/creates SET DEBUG FILE>,cr message < Packet traffic SET DEBUG PACKET>,cr message < Raw terminal i/o SET DEBUG RAW>,cr message < State transitions SET DEBUG STATE>,cr message message <Connection logging can be controlled by typing your>,cr message <escape character followed by a R to resume or a Q to>,cr message <stop logging.>,cr message return .dsabl lsb .sbttl set parity here .enabl lsb set$pa::calls getcm0 ,<argbuf,#parlst>; find out which option was given tst r0 ; did we find one bmi 110$ ; no jsr pc ,@r1 ; dispatch now 20$: mov r0 ,parity ; save for the show command cmpb r0 ,#par$no ; no parity? beq 100$ ; yes, no problem message <Kermit-11 will have to request 8 Bit quoting for the>,cr message <transmission of binary files. If the other Kermit>,cr message <does not support this, information for binary files>,cr message <will be lost.>,cr 100$: clr r0 ; exit with no error set return 110$: message <Unknown parity>,cr return .dsabl lsb cm$glob = 0 command parlst ,EVEN ,3 ,spa$ev command parlst ,ODD ,3 ,spa$od command parlst ,MARK ,3 ,spa$ma command parlst ,SPACE ,3 ,spa$sp command parlst ,NONE ,3 ,spa$no command parlst spa$ev: mov #par$ev ,r0 ; set parity even return spa$od: mov #par$od ,r0 ; set parity odd return spa$ma: mov #par$ma ,r0 ; set parity mark return spa$sp: mov #par$sp ,r0 ; set parity space return spa$no: mov #par$no ,r0 ; set parity none return global <Argbuf ,parity> .sbttl set handshake squote = 47 dquote = 42 ; 03-Aug-84 09:36:52 Allow literal characters like SET HAN '? set$ha::call ttchk ; insure a line is set bcs 100$ ; no, they must set line first mov argbuf ,r0 ; get the address of argbuf cmpb @r0 ,#squote ; a literal quoted character? beq 10$ ; yes, use the next character as the cmpb @r0 ,#dquote ; handshake character. Look for " also bne 20$ ; no 10$: movb 1(r0) ,r0 ; get the handshake character please br 30$ ; and copy it please 20$: calls getcm0 ,<r0,#hanlst> ; find out which option was given tst r0 ; did we find one bmi 110$ ; no jsr pc ,@r1 ; dispatch now 30$: movb r0 ,handch ; save for the show command 100$: clr r0 ; exit with no error set 110$: return cm$glob = 0 command hanlst ,NONE ,3 ,sha$no command hanlst ,XON ,3 ,sha$xn command hanlst ,XOFF ,3 ,sha$xf command hanlst ,CARRIAGE-RETURN,3 ,sha$cr command hanlst ,CARRIAGE_RETURN,3 ,sha$cr command hanlst sha$no: clrb r0 ; no handshake (the default) return sha$xn: movb #'Q&37 ,r0 ; wait for an XON return sha$xf: movb #'S&37 ,r0 ; wait for an XOFF (??) return sha$cr: movb #cr ,r0 ; wait for a carriage return return .sbttl set DUPLEEX and SET LOCAL ; Provide both SET DUPLEX FULL/HALF and SET LOCAL ON/OFF ; to provide user's with compatibility with the different ; ways other Kermits do this. set$lc::mov #lcelst ,r5 br dulc set$du::mov #duplst ,r5 dulc: call ttchk ; insure a line is set bcs 100$ ; no, they must set line first 10$: calls getcm0 ,<argbuf,r5> ; find out which option was given tst r0 ; did we find one bmi 110$ ; no jsr pc ,@r1 ; dispatch now 100$: clr r0 ; exit with no error set 110$: return sdu$ha: mov sp ,duplex ; simple return sdu$fu: clr duplex ; the default return $cmglob = 0 command duplst ,FULL ,2 ,sdu$fu command duplst ,HALF ,2 ,sdu$ha command duplst command lcelst ,ON ,2 ,sdu$ha command lcelst ,OFF ,2 ,sdu$fu command lcelst global <argbuf ,duplex ,handch> .sbttl set ibm (may be site dependent) set$ib::calls getcm0 ,<argbuf,#ibmlst>; find out which option was given tst r0 ; did we find one bmi 110$ ; no jsr pc ,@r1 ; dispatch now 100$: clr r0 ; exit with no error set 110$: return $cmglob = 0 command ibmlst ,ON ,2 ,sib$on command ibmlst ,OFF ,2 ,sib$of command ibmlst sib$on: mov sp ,duplex ; half duplex mov #par$ma ,parity ; mark parity movb #'Q&37 ,handch ; XON handshaking message <SET DUPLEX HALF, SET PARITY MARK, SET HANDSHAKE XON done>,cr return ; bye sib$of: clr duplex ; full duplex mov #par$no ,parity ; no parity clrb handch ; no handshaking message <SET DUPLEX FULL, SET PARITY NONE, SET HANDSHAKE NONE done>,cr return .sbttl set [no]quiet set$qu::clr infomsg ; /41/ Disallow full info messages clr tkecho ; /41/ No command file echoing clr r0 ; /41/ Return( success ) return ; /41/ Exit set$nq::mov sp ,infomsg ; /41/ Allow full info messages mov sp ,tkecho ; /41/ Command file echoing clr r0 ; /41/ Return( success ) return ; /41/ Exit global <infomsg,tkecho> .sbttl set logout_string ; Accept a string sequence as in SET LOGO BYE<15><12> ; ; Added edit /41/ 27-Dec-85 12:01:05 BDN re Steve Heflin's mods. set$ls::prsbuf #logstr return global <argbuf,logstr> .sbttl set update value set$nu::clr blip clr r0 return set$up::calls l$val ,<argbuf> ; get the interval into decimal tst r0 ; ok ? bne 100$ ; no mov r1 ,blip ; yes, set it up please clr r0 return 100$: mov #1 ,r0 return set$po::calls getcm0 ,<argbuf,#poslst>; find out which option was given tst r0 ; did we find one bmi 110$ ; no jsr pc ,@r1 ; dispatch now clr r0 110$: return $cmglob = 0 command poslst ,NODTE ,2 ,spo$nd command poslst ,DTE ,2 ,spo$dt command poslst spo$nd: clr procom return spo$dt: mov sp ,procom return global <procom> .sbttl SET RSX set$rx::calls getcm0 ,<argbuf,#rsxlst>; find out which option was given tst r0 ; did we find one bmi 110$ ; no jsr pc ,@r1 ; dispatch now 110$: return $cmglob = 0 command rsxlst ,CHARIO ,2 ,srx$ch command rsxlst ,LINEIO ,2 ,srx$li command rsxlst ,TC.DLU ,2 ,srx$tc command rsxlst ,CONNECT,2 ,srx$co command rsxlst srx$ch: mov sp ,chario clr r0 return srx$li: clr chario clr r0 return .enabl lsb srx$tc: mov argbuf ,r0 ; attempt to resolve the tc.dlu 10$: tstb @r0 ; question for connecting to a beq 90$ ; modem. cmpb (r0)+ ,#40 ; scan for a trailing space bne 10$ ; not found yet 20$: movb @r0 ,r1 ; found space, next character must sub #'0 ,r1 ; be a digit from 0..2 bmi 90$ ; no good cmp r1 ,#2 ; check for upper limit now bhi 90$ ; no good mov r1 ,tcdlu ; save it clr r0 ; and exit br 100$ 90$: message <SET RSX TC.DLU value, where value is 0..2>,cr mov #1 ,r0 100$: return .dsabl lsb .enabl lsb srx$co: call nextarg ; next one please 20$: cmpb @r1 ,#'D&137 ; SET RSX CONNECT DEFAULT bne 30$ ; no clr con$dsp ; /44/ yes, clear ALTCON then br 100$ 30$: cmpb @r1 ,#'A&137 ; SET RSX CONNECT ALTERNATE bne 90$ ; no mov altcon ,con$dsp ; /44/ br 100$ 90$: message <?Error - SET RSX CON [DEF][ALT]>,cr 100$: clr r0 return .dsabl lsb global <altcon ,chario ,tcdlu> global <con$dsp> ; /44/ .sbttl SET RT11 (10-Sep-85 13:11:38) ; SET RT11 FLOW_CONTROL ON ; SET RT11 FLOW_CONTROL OFF ; SET RT11 [NO]FLOW_CONTROL ; SET RT11 [NO]VOLUME_VERIFY ; SET RT11 CREATE_SIZE n ; SET RT11 BREAK [LONG][SHORT] ; SET RT11 [NO]WILDCARD set$rt::calls getcm0 ,<argbuf,#rtlist> tst r0 bmi 110$ jsr pc ,@r1 110$: return srt$wc: clr nowild ; /51/ Clear it clr r0 ; /51/ Success return srt$nw: mov sp ,nowild ; /51/ Set it clr r0 ; /51/ Success return ; /51/ Exit srt$cr: call nextarg ; see if another arg present tstb @r1 ; well? beq 90$ ; no calls l$val ,<r1> ; yes, see if a good number tst r0 ; well ? bne 90$ ; no mov r1 ,en$siz ; yes, save it please return ; exit 90$: message <%SET-W SET RT11 CREATE_SIZE decimal_value>,cr return srt$fl: call nextarg ; get third argument in command tstb @r1 ; did we find one or stop on null beq 90$ ; null, assume SET RT11 FLOW_CONTROL cmpb (r1)+ ,#'O&137 ; must be 'O' next bne 110$ ; not 'O', error clr r0 ; assume no flow control cmpb (r1)+ ,#'F&137 ; 'F' --> SET RT11 FLOW OFF beq 100$ ; ok 90$: mov sp ,r0 ; not off, assume ON 100$: mov r0 ,rtflow ; store the value and exit clr r0 return 110$: message <%SET-W SET RT11 FLOW [ON][OFF]>,cr mov #1 ,r0 return srt$br: call nextarg ; /43/ Get third argument in command mov #17. ,r0 ; /43/ Assume short break tstb @r1 ; /43/ Did we find one or stop on null beq 100$ ; /43/ Assume SET RT11 BREAK SHORT cmpb @r1 ,#'S&137 ; /43/ 'SHORT' ? beq 100$ ; /43/ Yes, exit cmpb @r1 ,#'L&137 ; /43/ 'LONG' ? bne 110$ ; /43/ No, error mov #60.*3 ,r0 ; /43/ Yes, set three second break 100$: mov r0 ,brklen ; /43/ Store the value and exit clr r0 return 110$: message <%SET-W SET RT11 BREAK [SHORT][LONG]>,cr mov #1 ,r0 return srt$vo: mov sp ,rtvol clr r0 return srt$nv: clr rtvol clr r0 return srt$nf: clr rtflow clr r0 return cm$glob = 0 command rtlist ,FLOW_CONTROL ,2 ,srt$fl command rtlist ,NOFLOW_CONTROL ,2 ,srt$nf command rtlist ,NOVOLUME_VERIFY,3 ,srt$nv command rtlist ,VOLUME_VERIFY ,3 ,srt$vo command rtlist ,CREATE_SIZE ,2 ,srt$cr command rtlist ,BREAK ,2 ,srt$br command rtlist ,WILDCARDING ,2 ,srt$wc command rtlist ,NOWILDCARDING ,3 ,srt$nw command rtlist global <argbuf ,en$siz ,rtflow ,rtvol ,brklen ,nowild> .sbttl disable xon/xoff flow control for RT11 (old command) ; SET RTFLOW ON ; SET RTFLOW OFF ; ; We need this because some modems (like the VADIC 212) can't ; handle XON's and XOFF's comming from the connect code. Thus ; we need a way to disable this. We need flow control for the ; connect command for RT11 due to the speed limitations of MT ; service. set$cf::calls getcm0 ,<argbuf,#cflst>; find out which option was given tst r0 ; did we find one bmi 110$ ; no jsr pc ,@r1 ; dispatch now mov r0 ,conflow ; save for the show command 100$: clr r0 ; exit with no error set 110$: return cm$glob = 0 command cflst ,OFF ,3 ,scf$of command cflst ,ON ,2 ,scf$on command cflst ,NONE ,3 ,scf$of command cflst scf$of: clr r0 return scf$on: mov sp ,r0 return .sbttl set server set$sv::calls getcm0 ,<argpnt,#svlst>; find out which option was given tst r0 ; did we find the option ? bmi 100$ ; no calls getcm1 ,<argpnt,#svlst,r0> ; yes, look for value clause now tst r0 ; find it (or read it?) bmi 100$ ; no mov argbuf ,argpnt ; yes. GETCM1 always returns in ARGBUF jsr pc ,@r1 ; dispatch to correct action br 110$ ; and exit 100$: mov #1 ,r0 ; exit on error 110$: mov argbuf ,argpnt ; insure argpnt is reset to default return ; exit srv$ti: calls l$val ,<argbuf> tst r0 bne 100$ mov r1 ,serwait clr r0 100$: return srv$nt: mov #60.*120.,serwait ; wait a couple of hours clr r0 ; success return srv$dd: call ttchk ; /45/ MUST do a SET LINE first bcc 10$ ; /45/ It's ok clr srvprot ; /45/ Insure it's off mov #1 ,r0 ; /45/ Not ok, return status return ; /45/ Exit 10$: mov sp ,srvprot ; /45/ Insure that REMOTE FIN and clr r0 ; /45/ REMOTE BYE can't function. return ; /45/ Exit, success srv$nd: clr srvprot ; /45/ Undo SET SERVER DEDICATED clr r0 ; /45/ Success return ; /45/ Exit srv$dt: mov sp ,srvdet ; /45/ Flag for detaching server clr r0 ; /45/ Success return ; /45/ Exit command svlst ,TIME_OUT ,2 ,srv$ti ,<Server_Idle timeout? >,decnum command svlst ,NOTIME_OUT ,3 ,srv$nt command svlst ,TIME-OUT ,2 ,srv$ti ,<Server_Idle timeout? >,decnum command svlst ,NOTIME-OUT ,3 ,srv$nt command svlst ,DEDICATED ,3 ,srv$dd command svlst ,NODEDICATED ,3 ,srv$nd command svlst ,DETACH ,3 ,srv$dt command svlst global <serwait> .sbttl SET EOF [NO]EXIT set$ef::calls getcm0 ,<argbuf,#eflist> tst r0 bmi 110$ jsr pc ,@r1 110$: return command eflist ,NOEXIT ,2 ,sef$ne command eflist ,EXIT ,2 ,sef$ex command eflist sef$ne: clr exieof clr r0 return sef$ex: mov sp ,exieof clr r0 return global <exieof> .sbttl SET DIAL commands .enabl lsb ; Assumed: SET MODEM USER_DEFINED already done ; ; SET DIAL WAKEUP get_modems_attention (VA212PA: "\05\015") ; SET DIAL PROMPT modems_prompt (VA212PA: "*") ; SET DIAL INIT dial_initiate (VA212PA: "D\015") ; SET DIAL FORMAT dial_formatter (VA212PA: "%s") ; SET DIAL CONFIRM number_confirm (VA212PA: "\015") ; SET DIAL SUCCESS on_line_string (VA212PA: "ONLINE") ; SET DIAL INFO ringing_message (VA212PA: "RINGING") ; SET DIAL FAILURE failed_call (VA212PA: "BUSY") ; ; The first 5 are permanent fields in the modem descriptor. ; The SUCCESS, INFO and FAILURE fields are built as linked ; lists, thus you can have as many as desired. ; ; The CONFIRM and INFO fields are optional. set$di::mov #dialst ,r3 sub #140 ,sp ; A temp buffer mov sp ,r4 ; A pointer to this buffer calls getcm0 ,<argbuf,r3> ; Find out which option was given tst r0 ; Did we find the option ? bmi 100$ ; No calls getcm1 ,<argbuf,r3,r0>; Yes, look for value clause now tst r0 ; Find it (or read it?) bmi 100$ ; No jsr pc ,@r1 ; Dispatch to correct action tst r0 beq 100$ message <%SET-W Unknown option in SET DIAL>,cr 100$: add #140 ,sp ; Pop buffer return .dsabl lsb command dialst ,WAKEUP ,2 ,ss$wak,<String: >,string command dialst ,WAKE_STRING ,6 ,ss$wak,<String: >,string command dialst ,PROMPT ,2 ,ss$pro,<String: >,string command dialst ,INITIATE ,2 ,ss$ini,<String: >,string command dialst ,FORMAT ,2 ,ss$for,<String: >,string command dialst ,SUCCESS ,2 ,ss$suc,<Connect acknowledge: >,string command dialst ,INFORMATION ,2 ,ss$inf,<Ringing acknowledge: >,string command dialst ,FAILURE ,2 ,ss$fai,<Failure acknowledge: >,string command dialst ,CONFIRM ,2 ,ss$con,<String: >,string command dialst ,WAKE_RATE ,6 ,ss$wra,<Delay in milliseconds: >,decnum command dialst ,DIAL_RATE ,6 ,ss$dra,<Delay in milliseconds: >,decnum command dialst ,DIAL_PAUSE ,6 ,ss$pau,<Pause character(s): >,string command dialst ,TIMEOUT ,2 ,ss$tmo,<Timeout in seconds: >,decnum command dialst ,TIME_OUT ,2 ,ss$tmo,<Timeout in seconds: >,decnum command dialst .sbttl More SET DIAL commands ; MODEM type data structure. Taken directly from K11DIA.MAC mod.next =: 0 ; next modem in list mod.str =: 2 ; address of name of modem mod.val =: 4 ; numeric value for dispatching dial.time =: 6 ; value of dial time wake.string =: 10 ; address of wakeup string wake.rate =: 12 ; value of delay wake.prompt =: 14 ; address of wakeup prompt dmod.string =: 16 ; address of dial dial string dmod.prompt =: 20 ; address of prompt returned for dial dial.string =: 22 ; address of formatting string for dial dial.rate =: 24 ; value of delay wake.ack =: 26 ; address of wakeup response dial.ack =: 30 ; 1st = waitfor, 2nd to confirm number dial.online =: 32 ; online ack string dial.busy =: 34 ; busy ack dial.wait =: 36 ; Pause string dial.confirm =: 40 ; string to confirm number for dialing dial.go =: 42 ; ie, va212 returns "DIALING\n" res.bin =: 44 ; if <>, returns status with \n ; otherwise a binary response (DF03) dial.echo =: 46 ; if <>, numbers are echoed immediately mod.comment =: 50 ; res.head =: 52 ; ext.dial =: 54 ; if ne, address of external dialer dial.xabort =: 56 ; /45/ To abort call from modem dial.idle =: 60 ; /45/ Place modem in IDLE state dial.pulse =: 62 ; /45/ Switch to pulse dialing dial.nopulse =: 64 ; /45/ Switch to tone dialing def.guard =: 66 ; /45/ last thing (unused) .sbttl set dial, cont'd ss$pau: mov #dial.wait,r5 ; Pause character(s) call sd.chk ; Insert return ; and exit ss$wak: mov #wake.string,r5 ; Offset to setup call sd.chk ; Convert to binary and check return ss$for: mov #dial.string,r5 ; Formatting for dialing call sd.chk ; Convert, check and copy return ; Exit ss$pro: mov #wake.prompt,r5 ; String modem returns for wakeup, call sd.chk ; as in "HELLO: I'M READY" return ; Exit ss$ini: mov #dmod.string,r5 ; Could be part of SET DIAL FORMAT call sd.chk ; Used as in VA212 (D\015) return ss$con: mov #dial.confirm,r5 ; As in VA212PA, to confirm the call sd.chk ; number is actually correct return ss$suc: mov #1 ,r3 ; Message class call sd.res ; Insert response string return ss$inf: clr r3 ; Message class call sd.res ; Insert response string return ss$fai: mov #-1 ,r3 ; Message class call sd.res ; Insert response string return ss$dra: mov #dial.rate,r5 ; Stuff the value in now call sd.val ; .... return ; exit ss$wra: mov #wake.rate,r5 ; Stuff the value in now call sd.val ; .... return ; exit ss$tmo: calls l$val ,<argbuf> ; This goes into a global tst r0 ; Success bne 100$ ; No mov r1 ,diatmo ; Yes, exit 100$: return ; Bye global <argbuf,diatmo> .sbttl SET DIAL, cont'd .enabl lsb sd.chk: prsbuf r4 ; Expand and copy string to workbuffer tst r0 ; Successful? bne 100$ ; No strlen r4 ; Get the length of the result inc r0 ; Plus one for the null terminator inc r0 ; Insure NEXT is even address bic #1 ,r0 ; Even address boundary malloc r0 ; Ask for the allocation add umddef ,r5 ; mov r0 ,(r5) ; Insert the new buffer address strcpy (r5) ,r4 ; Copy the string and exit clr r0 ; Success br 100$ ; Exit 80$: message <Insufficient space to contain string>,cr 100$: return .dsabl lsb .enabl lsb sd.res: prsbuf r4 ; Expand and copy string to workbuffer tst r0 ; Successful? bne 100$ ; No strlen r4 ; Get the length of the result add #2 ,r0 ; Plus one for the null terminator bic #1 ,r0 ; Insure on a word boundary add #4 ,r0 ; Space for link and status mov umddef ,r5 ; Get base address of structure add #res.hea,r5 ; Link to first entry 10$: tst (r5) ; End of the chain yet? beq 20$ ; Yes mov (r5) ,r5 ; No, get the next one please br 10$ ; And recheck 20$: malloc r0 ; Ask for an allocation tst r0 ; Did we get it beq 80$ ; No, exit mov r0 ,(r5) ; Yes, insert the address beq 80$ ; /59/ Overflowed mov (r5) ,r5 ; Point directly to new area clr (r5)+ ; No link to next mov r3 ,(r5)+ ; Message class type strcpy r5 ,r4 ; Insert the string and exit clr r0 ; Success br 100$ ; Exit 80$: message <Insufficient space to contain string>,cr inc r0 ; Error 100$: return .dsabl lsb sd.val: add umddef ,r5 ; Point directly to the field calls l$val ,<argbuf> ; Anything there thats any good? tst r0 ; Success? bne 100$ ; No mov r1 ,(r5) ; Yes, insert the value and exit 100$: return global <argbuf> .sbttl set PHONE ; added /45/ along with SET DIAL set$ph::calls getcm0 ,<argbuf,#pholst>; Find out which option was given tst r0 ; Did we find the option ? bmi 100$ ; No calls getcm1 ,<argbuf,#pholst,r0>; Yes, look for value clause now tst r0 ; Find it (or read it?) bmi 100$ ; No jsr pc ,@r1 ; Dispatch to correct action 100$: return ; Exit command pholst ,NUMBER ,2 ,sph$nu,<Name and phonenumber: >,string command pholst ,PULSE ,2 ,sph$pu command pholst ,TONE ,2 ,sph$to command pholst ,BLIND ,2 ,sph$bl command pholst sph$to: mov #1 ,pulse clr r0 return sph$pu: mov #-1 ,pulse clr r0 return sph$bl: mov #1 ,blind clr r0 return sph$nu: mov #pnhead ,r5 ; Get listhead for phone numbers 10$: tst (r5) ; Found the last entry yet ? beq 20$ ; Yes, insert new element here mov (r5) ,r5 ; No, check the next one br 10$ ; Keep looking 20$: strlen argbuf ; Get total length of data add #4 ,r0 ; Add in space for nulls and insure bic #1 ,r0 ; even length, also link next field malloc r0 ; Ask for the space please mov r0 ,(r5) ; Insert the address beq 90$ ; No space clr (r0)+ ; This is now the tail strcpy r0 ,argbuf ; Stuff the data in and exit clr r0 ; Success return ; Bye 90$: message <No space left for numbers>,cr inc r0 ; Exit with error return ; Bye global <PNHEAD> ; List header global <PULSE> ; /54/ global <BLIND> ; /54/ nextarg:mov argbuf ,r1 10$: tstb @r1 beq 100$ cmpb (r1)+ ,#40 bne 10$ 100$: return .end